Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Development Platforms/Apple II/Apple II Sample Code/MPW IIGS SC/SC.001.Shell/Pascal Shell/Shell.p

Text File | 1990-06-24 | 13.7 KB | 547 lines | [TEXT/MPS ]

{
*    Standard Application Shell  - Pascal Version
*            Developer Technical Support
*
*        v3.0    Luther
}

{
*     Copyright (c) Apple Computer, Inc. 1988-1990
*                All Rights Reserved.
*
*     Developer Technical Support Apple II Sample Code
*
*    ------------------------------------------------------
*
*    This program and its derivatives are licensed only for
*    use on Apple computers.
*
*    Works based on this program must contain and
*    conspicuously display this notice.
*
*    This software is provided for your evaluation and to
*    assist you in developing software for the Apple IIGS
*    computer.
*
*    DISCLAIMER OF WARRANTY
*
*    THE SOFTWARE IS PROVIDED "AS IS" WITHOUT
*    WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED,
*    WITH RESPECT TO ITS MERCHANTABILITY OR ITS FITNESS
*    FOR ANY PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO
*    THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
*    YOU.  SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU (AND
*    NOT APPLE OR AN APPLE AUTHORIZED REPRESENTATIVE)
*    ASSUME THE ENTIRE COST OF ALL NECESSARY SERVICING,
*    REPAIR OR CORRECTION.
*
*    Apple does not warrant that the functions
*    contained in the Software will meet your requirements
*    or that the operation of the Software will be
*    uninterrupted or error free or that defects in the
*    Software will be corrected.
*
*    SOME STATES DO NOT ALLOW THE EXCLUSION
*    OF IMPLIED WARRANTIES, SO THE ABOVE EXCLUSION MAY
*    NOT APPLY TO YOU.  THIS WARRANTY GIVES YOU SPECIFIC
*    LEGAL RIGHTS AND YOU MAY ALSO HAVE OTHER RIGHTS
*    WHICH VARY FROM STATE TO STATE.
}


program Shell;

uses
    Types,
    GSOS,
    Locator,
    ADB,
    IntMath,
    TextTool,
    Memory,
    SANE,
    ACE,
    Resources,
    MiscTool,
    Scheduler,
    Loader,
    Quickdraw,
    QDAux,
    Events,
    Controls,
    Windows,
    Menus,
    LineEdit,
    Dialogs,
    Sound,
    NoteSyn,
    NoteSeq,
    MIDI,
    StdFile,
    Scrap,
    Desk,
    Lists,
    Fonts,
    Print,
    TextEdit,
    Video;

const
    { menu item numbers for standard DA menu items }
    UndoID        = 250;
    CutID        = 251;
    CopyID        = 252;
    PasteID        = 253;
    ClearID        = 254;
    CloseID        = 255;

    { application menu item numbers }
    AboutID            = $1101;    { 1st item of 1st menu of 1st menu bar }
    QuitID            = $1202;    { 2nd item of 2nd menu of 1st menu bar }

    { application menu numbers }
    AppleMenuID        = $1100;    { 1st menu of 1st menu bar }
    FileMenuID        = $1200;    { 2nd menu of 1st menu bar }
    EditMenuID        = $1300;    { 3rd menu of 1st menu bar }

    { resource ID numbers }
    BaseResID        = $00000000;    { start of resource ID numbers }
    MenuBarOneRID    = $00001000;    { resource ID of menu bar }

    MyTaskMask        = $001FFFFF;{ handle all events possible }

var
    { Standard global variables here }
    MyMemoryID        : integer;    { application's memory ID }
    Done            : boolean;    { flag to show when to quit application }
    ToolRecRef        : Ref;        { StartStopRecRef from StartUpTools }
    WindowKind        : integer;    { type of top window from GetWKind call }
    MenuHeight        : integer;    { stored height of menu bar }

    { The following is the record that is used by TaskMaster to return
      events. It is similar to a regular event record, except that there are
      additional fields at the end. The first additional field is used to
      convey some TaskMaster specific data back to the application. The second
      additional field is called the TaskMask and is used to tell TaskMaster
      what situations to handle.  In this shell, we tell TaskMaster to handle
      everything by setting all currently defined bits to 1 (MyTaskMask) in
      the initApp procedure. }

    MyEvent            : wmTaskRec;


{******************************************************************************
*
* errorCheck:    This procedure is declared forward. This lets you check for
*                fatal errors and still shut down fairly cleanly from
*                anywhere in your program.
}

procedure errorCheck(where : Integer);
    FORWARD;


{******************************************************************************
*
* doQuit:        Set the Done flag to true. This tells the Event loop to exit.
*
* Inputs:        NONE
* Outputs:        Done set to true
* Calls:        NONE
}

procedure doQuit;

begin
    Done := true;
end;


{******************************************************************************
*
* doAbout:        Bring up an Alert Dialog box with our about message in it.
*
* Inputs:        NONE
* Outputs:        NONE
* Calls:        NONE
}

procedure doAbout;

const
    alertFlags    = 4;        { reference is a ResourceID }

var
      buttonHit    : integer;        { button number clicked }

begin
    buttonHit := AlertWindow(alertFlags,NIL,Pointer(BaseResID+1));
end;


{******************************************************************************
*
* doMenu:        This routine is called when TaskMaster returns a menu
*                event. It takes the menu item that was hit and calls the
*                proper routine, and then unhilites the menu when it is done.
*
* Inputs:        TaskData holds menu item selected.
* Outputs:        NONE
* Calls:        doAbout, doQuit
}

procedure doMenu;

const
    alertFlags    = 4;            { reference is a ResourceID }
var
      menuNum,                    { ID of menu from which selection was made }
    itemNum        : integer;        { ID of selected menu item }
      buttonHit    : integer;        { button number clicked }

begin
    menuNum := HiWord(MyEvent.wmTaskData);    { get menu ID }
    itemNum := LoWord(MyEvent.wmTaskData);    { and item ID from MyEvent}

    case itemNum of
        AboutID    : doAbout;    { show About alert }
        QuitID    : doQuit;    { set Done flag }
        UndoID    :;
        CutID    :;
        CopyID    :;
        PasteID    :;
        ClearID    :;
        CloseID :;            { close taken care of by TaskMaster }
        otherwise
            buttonHit := AlertWindow(alertFlags,NIL,Pointer(BaseResID+2));
    end;

    {     The routine has been called. Unhilite the menu and return to the
        Main Event Loop. }

    HiLiteMenu(false,menuNum);
end;


{******************************************************************************
*
* doSysChange:    Called by testTopWindow when the active window
*                has changed to or from a system window.
*
* Inputs:        Bit 15 of WindowKind is 0 if top window is an application
*                window, 1 if top window is a system window.
* Outputs:        NONE
* Calls:        NONE
}

procedure doSysChange;

begin
    if WindowKind < 0    { if bit 15 of WindowKind = 1 }
        then
            begin
                { enable the edit menu items and the close item }
                EnableMItem(UndoID);
                EnableMItem(CutID);
                EnableMItem(CopyID);
                EnableMItem(PasteID);
                EnableMItem(ClearID);
                EnableMItem(CloseID);

                { if your edit menu has items that are selectable when a
                  NDA is not the active window, remove the next two lines. }
                SetMenuFlag(enableMenu,EditMenuID);
                HiliteMenu(false, EditMenuID);
            end
        else
            begin
                 { disable the edit menu items and the close item }
                DisableMItem(UndoID);
                DisableMItem(CutID);
                DisableMItem(CopyID);
                DisableMItem(PasteID);
                DisableMItem(ClearID);
                DisableMItem(CloseID);

                { if your edit menu has items that are selectable when a
                  NDA is not the active window, remove the next two lines. }
                SetMenuFlag(disableMenu,EditMenuID);
                HiliteMenu(false, EditMenuID);
            end;
end;


{******************************************************************************
*
* testTopWindow:This routine is called on every time through the event loop.
*                If the type to the top window has changed from application
*                window to system window or back, this routine will call
*                doSysChange.
*
* Inputs:        NONE
* Outputs:        NONE
* Calls:        doSysChange
}

procedure testTopWindow;

var
      tempWindowPtr    : WindowPtr;    { active window's grafPort }
    tempWindowKind    : integer;    { active window's kind }

begin
    tempWindowPtr := FrontWindow;    { get active window's grafPort }

    if tempWindowPtr <> NIL     { if there is an active window }
        then tempWindowKind := GetWKind(tempWindowPtr) { get its kind }
        else tempWindowKind := 0; { force to application window kind }

    if tempWindowKind <> WindowKind
        then                     { window kind has changed }
            begin                 { save the WindowKind and change the menus }
                WindowKind := tempWindowKind;
                doSysChange;
            end;
end;


{******************************************************************************
*
* closeTools:    Shut down the tools I started.
*
* Inputs:        NONE
* Outputs:        NONE
* Calls:        NONE
}

procedure closeTools;

begin
    { shut down tools started by StartUpTools }
    ShutDownTools(refIsHandle,ToolRecRef);

    { shut down Memory Manager and Tool Locator }
    MMShutDown(MyMemoryID);
    TLShutDown;
end;


{******************************************************************************
*
* closeApp:        Close down things. This disposes of all items and
*                memory that we allocated. Usually undoes what was done
*                in initApp.  We don't close our window since _WindShutDown
*                does it for us.
*
* Inputs:        NONE
* Outputs:        NONE
* Calls:        NONE
}

procedure closeApp;

begin
    { do nothing in this shell }
end;


{******************************************************************************
*
* eventLoop:    The Event Loop. Handle things until user selects Quit.
*
* Inputs:        NONE
* Outputs:        NONE
* Calls:        testTopWindow, doMenu
}

procedure eventLoop;

var
      taskCode    : integer;        { code indicating action to be taken }

begin
    repeat
        testTopWindow;            { test top window to see if it is a NDA }

        taskCode := TaskMaster(EveryEvent,MyEvent);
        case taskCode of        { handle the event for this taskcode }
            {    With most of these events, we do nothing (in fact, most
                applications will never see some of these events). You
                should cut the labels for events your application does
                not use out of this case statement. Any of these events
                your application does use should call a procedure to handle
                the event.    }
            nullEvt:;
            mouseDownEvt:;
            mouseUpEvt:;
            keyDownEvt:;
            autoKeyEvt:;
            updateEvt:;
            activateEvt:;
            switchEvt:;
            deskAccEvt:;
            driverEvt:;
            app1Evt:;
            app2Evt:;
            app3Evt:;
            app4Evt:;
            wInDesk:;
            wInMenuBar,                { do "In system menu bar" events and }
            wInSpecial:    doMenu;        { "Item ID selected was 250-255" events }
            wClickCalled:;
            wInContent:;
            wInDrag:;
            wInGrow:;
            wInGoAway:;
            wInZoom:;
            wInInfo:;
            wInDeskItem:;
            wInFrame:;
            wInactMenu:;
            wClosedNDA:;
            wCalledSysEdit:;
            wTrackZoom:;
            wHitFrame:;
            wInControl:;
            wInControlMenu:;
        end;
    until Done;                        { Loop until "Quit" is selected }
end;


{******************************************************************************
*
* initApp:        Perform any application specific initialization. For this app,
*                we initialize the Done to false, set WindowKind to an
*                application window kind, initialize the TaskMask in the event
*                record, and initialize all of the menus.
*                .
*                You might use this procedure to create windows,
*                initialize variables and allocate memory needed for
*                the entire program.
*
* Inputs:        NONE
* Outputs:        NONE
* Calls:        NONE
}

procedure initApp;

begin
    Done := false;                { we aren't done yet }

    WindowKind := 0;            { window kind  = application }

    { tell TaskMaster what events to handle }
    MyEvent.wmTaskMask := MyTaskMask;

    { create default system menu bar from a resource
      and make it the current menu bar }

    SetSysBar(NewMenuBar2(refIsResource,Ref(MenuBarOneRID),NIL));
    SetMenuBar(NIL);

    RefreshDeskTop(NIL);        { redraw the desktop }

    InitCursor;                    { normal arrow cursor }

    FixAppleMenu(AppleMenuID);    { add NDAs to Apple menu }
    MenuHeight := FixMenuBar;    { set menu bar height }
    DrawMenuBar;                { draw the menu bar }
end;


{******************************************************************************
*
* errorCheck:    This routine is called by initTools to check for startup
*                errors. An error message is shown and everything is
*                shut down if any errors are detected.
*
* Inputs:        where = the reference number that tells you where in the
*                initTools procedure the error happened.
* Outputs:        NONE (program exits)
* Calls:        closeTools
}

procedure errorCheck(where : Integer);

var
    theError    : integer;        { the tool error number }
      errStr        : str255;        { string to display error message }
    tempChar    : integer;        { temp to eat character returned }

begin
    if _toolErr <> 0 { _toolErr is an external var }
        then
            begin
                theError := _toolErr;    { store the error number }

                { initialize errStr }
                errStr :=
            'Fatal Error $xxxx has occurred at xxxx. Press any key to exit:';

                { Stick error # into a string }
                Int2Hex(theError,Pointer(Ord4(@errStr)+14),4);

                { Stick loc # into a string }
                Int2Hex(where,Pointer(Ord4(@errStr)+35),4);

                GrafOff;                        { turn off super Hires }
                WriteLine(errStr);                { write errStr to text screen }
                SysBeep;                        { ring the bell }
                tempChar := ReadChar(noEcho);    { & wait for keypress }

                closeTools;        { ShutDown my Tools }
                Halt;            { quit with APW status = 1 }
                                { Halt may be a compiler specific procedure }
            end;
end;


{******************************************************************************
*
* initTools:    Load and startup the tools needed. errorCheck is called
*                after each startup to check for errors.
*
* Inputs:        NONE
* Outputs:        NONE
* Calls:        errorCheck
}

procedure initTools;

begin
    TLStartUp;                    { start up Tool Locator }
    errorCheck(1);                { Make sure all is OK }

    MyMemoryID := MMStartUp;    { start up Memory Manager & get Memory ID }
    errorCheck(2);                { Make sure all is OK }

    { start up the rest of the tools }
    ToolRecRef := StartUpTools(MyMemoryID,refIsResource,Ref(BaseResID+1));
    errorCheck(3);                { Make sure all is OK }
end;


{******************************************************************************
*
* main:            This is the main routine. It calls procedures to startup
*                the tools, initialize application specific data, run the
*                main eventLoop, close the application, and shutdown the tools.
*
* Inputs:        NONE
* Outputs:        NONE
* Calls:        initTools, initApp, eventLoop, closeApp, closeTools
}

begin
    initTools;                { Initialize tools. }
    initApp;                { Initialize application specific stuff. }

    eventLoop;                { Do application stuff until user wants to
                              do something else! }

    closeApp;                { ShutDown application specific things. }
    closeTools;                { ShutDown the tools. }
end.